#!/usr/bin/perl -w

# f77.pl
# Copyright (C) 2013 Konstantin Grigoryev
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foun-
# dation, Inc., 51 Franklin Street, 5h Floor, Boston, MA 02110-1301, USA.


# The following non-standard features are supported:
#   - Unlimited line length;
#   - Symbolic names of any length;
#   - Exclamation mark in columns 0, 6..* for comments.


# Settings
$length_limit = 72;  # Comment out to enable unlimited lines
$eol_comments = 1;   # Enables comments starting with `!`


# Language-specific constants
$label_col = 0;  # Labels are placed in columns 0..4    
$cmark_col = 5;  # Continuation mark is in column 5
$stmnt_col = 6;  # Statement starts in column 6

$comment_chars  = "C";
$comment_chars .= "!" if $eol_comments;


# Complier messages of various severity

sub information {
    my ($lineno, $text) = @_;
    print STDERR "$lineno: $text\n";
}

sub warning {
    my ($lineno, $text) = @_;
    print STDERR "$lineno: $text\n";
}

sub error {
    my ($lineno, $text) = @_;
    print STDERR "$lineno: $text\n";
}

sub fatal {
    my ($lineno, $text) = @_;
    print STDERR "$lineno: $text\n";
}


sub label {}
sub statement {}


sub processLine {
    my ($lineno) = @_;
    
    # Trancation and padding
    if (defined($length_limit)) {
        if (length() > $length_limit) {
            warning($lineno, "Line too long and will be truncated");
            substr($_, $length_limit) = "";
        }
        else {
            $_ .= " " x ($length_limit - length());
        }
    }
    
    # Skip blank lines and comments
    if (/^\s*$/ or /^[$comment_chars]/io) {
        return;
    }

    ##TODO Things of such kind should be done using array
    my $label = substr($_, $label_col, $cmark_col - $label_col);
    my $cmark = substr($_, $cmark_col, $stmnt_col - $cmark_col);
    my $stmnt = substr($_, $stmnt_col);

    my $has_label = ($label =~ /\S/);
    my $has_cmark = ($cmark =~ /\S/);

    if ($has_label) {
        label($lineno, $label);
    }
    if ($has_cmark and defined($accum)) {
        $accum .= "\n" . $stmnt;
    }
    else {
        if (defined($accum)) {
            statement($accum_lineno, $accum);
        }
        elsif ($has_cmark) {
            error($lineno, "Continuation without preceding statement");
        }
        $accum        = $stmnt;
        $accum_lineno = $lineno;
    }
}


while (<>) {
    chomp();
    processLine(++$lineno);
}

# Compile the last statement, if any
statement($accum_lineno, $accum) if defined($accum);
